Course Coordinates

ds4psy

spds.uni.kn

R art

See https://www.r-graph-gallery.com/portfolio/data-art/ for examples.

Matrix

# plotting parameters: 
opar <- par(no.readonly = TRUE)  # all par settings that can be changed.

Original version:

# Source: http://www.r-graph-gallery.com/56-matrix-abstract-painting/

# generate pairs of x-y values
nx = 100
ny = 80
x = sample(x = 1:nx, size = 90, replace = TRUE)
y = seq(-1, -ny, length = 90)
 
# set graphical parameters: 
op = par(bg = "black", mar = c(0, 0.2, 0, 0.2))
 
# plot: 
plot(1:nx, seq(-1, -nx), type = "n", xlim = c(1, nx), ylim = c(-ny+10, 1))
for (i in seq_along(x))
{
  aux = sample(1:ny, 1)
  points(rep(x[i], aux), y[1:aux], pch = sample(letters, aux, replace = TRUE), 
         col = hsv(0.35, 1, 1, runif(aux, 0.3)), cex = runif(aux, 0.3))
}
 
# signature: 
legend("bottomright", legend = "© Gaston Sanchez", bty = "n", text.col = "gray70")

Adpated version:

# Source: http://www.r-graph-gallery.com/56-matrix-abstract-painting/
    
# generate pairs of x-y values
nx <- 100
ny <-  80

x <- sample(x = 1:nx, size = (nx - 10), replace = TRUE)
y <- seq(-1, -ny, length = (nx - 10))

# plotting parameters: 
op <- par(bg = "black", mar = c(0, 0.2, 0, 0.2))

seeblau_rgb <- col2rgb(seeblau)
seeblau_hsv <- rgb2hsv(seeblau_rgb)
unikn_sample <- c("d", "s", "4", "p", "s", "y",  
                  "3", "7", "9")

# Create empty plot:
plot(1:nx, seq(-1, -nx), type = "n", xlim = c(1, nx), ylim = c(-ny + 10, 1))

# Loop:
for (i in seq_along(x))
{
  aux = sample(1:ny, 1)
  points(rep(x[i], aux), y[1:aux], pch = sample(unikn_sample, aux, replace = TRUE), 
         col = hsv(seeblau_hsv[[1]], 1, 1, alpha = runif(aux, 0.3)), cex = runif(aux, 0.3))
}

## Save plot manually (as not a ggplot object)! 

## Clean up: 
par(opar)  # restore original plot settings

Rings

Original version:

# Source: http://www.r-graph-gallery.com/58-saturn-rings-abstract-painting/
    
# generate pairs of x-y values
x = seq(-50, 50, by = 1)
y = -(x^2)
 
# set graphic parameters
op = par(bg = 'black', mar = rep(0.5, 4))
 
# Plot 
plot(y, x, type = 'n')
lines(y, x, lwd = 2*runif(1), col = hsv(0.08, 1, 1, alpha = runif(1, 0.5, 0.9)))
for (i in seq(10, 2500, 10))
{
  lines(y-i, x, lwd = 2*runif(1), col = hsv(0.08, 1, 1, alpha = runif(1, 0.5, 0.9)))
}
for (i in seq(500, 600, 10))
{
  lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0.5, 0.9)))
}
for (i in seq(2000, 2300, 10))
{
  lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0.5, 0.9)))
}
for (i in seq(100, 150, 10))
{
  lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0.5, 0.9)))
}
 
# signature
legend("bottomright", legend="© Gaston Sanchez", bty = "n", text.col="gray70")

Adapted version:

# Adapted from: http://www.r-graph-gallery.com/58-saturn-rings-abstract-painting/
    
# generate pairs of x-y values:
x = seq(-50, 50, by = 1)
y = -(x^2)
 
# set graphic parameters:
op = par(bg = "black", mar = rep(.5, 4))
# op = par(bg = "white", mar = rep(.5, 4))

original_h <- .08  # original hue value
# Seeblau versions:
seeblau_rgb <- col2rgb(seeblau)
seeblau_hsv <- rgb2hsv(seeblau_rgb)
seeblau_hsv 
#  seeblau
# h 0.5409226
# s 1.0000000
# v 0.8784314

seeblau_h <- seeblau_hsv[[1]]

white_rgb <- col2rgb("white")
white_hsv <- rgb2hsv(white_rgb)
white_hsv  # 0 0 1

grey_rgb <- col2rgb("grey")
grey_hsv <- rgb2hsv(grey_rgb)
grey_hsv  # 0 0 0.75

# Plot: 
plot(y, x, type = 'n')

# one: 
lines(y, x, lwd = 2 * runif(1), col = hsv(seeblau_h, 1, 1, alpha = runif(1, .5, .9)))

# all: 
for (i in seq(10, 2500, 10)) {
  lines(y-i, x, lwd = 2 * runif(1), col = hsv(seeblau_h, 1, 1, alpha = runif(1, .5, .9)))
}

# inner: 
for (i in seq(500, 600, 10)) {
  lines(y - i, x, lwd = 2 * runif(1), col = hsv(0, 0, .75, alpha = runif(1, .5, .9)))
}

# middle:
for (i in seq(2000, 2300, 10)) {
  lines(y - i, x, lwd = 2 * runif(1), col = hsv(0, 0, .75, alpha = runif(1, .5, .9)))
}

# outer:
for (i in seq(100, 150, 10)){
  lines(y - i, x, lwd = 2 * runif(1), col = hsv(0, 0, .75, alpha = runif(1, .5, .9)))
}

## Save plot manually (as not a ggplot object)! 

## Clean up: 
par(opar)  # restore original plot settings

Grasslands

Original version:

# Source: https://www.r-graph-gallery.com/138-green-world-data-art/

library(ggplot2)
library(RColorBrewer)

set.seed(92)
ngroup=20
names=paste("G_",seq(1,ngroup),sep="")
DAT=data.frame()

for(i in seq(1:50)){
    data=data.frame( matrix(0, ngroup , 3))
    data[,1]=i
    data[,2]=sample(names, nrow(data))
    data[,3]=prop.table(sample( c(rep(0, 100), c(1:ngroup)), nrow(data)))
    DAT=rbind(DAT,data)
    }

colnames(DAT) = c("Year","Group","Value")
DAT = DAT[order(DAT$Year, DAT$Group), ]

ggplot(DAT, aes(x=Year, y=Value, fill=Group )) + 
    geom_area(alpha=1 , color="transparent" )+
    theme_bw() +
    scale_fill_brewer(palette="Greens", breaks=rev(levels(DAT$Group)))+
     theme(line = element_blank(),
        text = element_blank(),
        title = element_blank(),
        legend.position = "none",
        panel.border = element_blank(),
        panel.background = element_blank())

Adapted version:

# Adapted from: https://www.r-graph-gallery.com/138-green-world-data-art/

library(ggplot2)
library(RColorBrewer)

set.seed(101)

ngroup <- 20
names <- paste("G_", seq(1, ngroup), sep = "")
DAT <- data.frame()

# Color palette: 
seeblau_pal <- sample(unikn.pal, size = ngroup, replace = TRUE)
seeblau_pal <- rep(c(unikn.pal[1], unikn.pal[2], unikn.pal[3], unikn.pal[4], unikn.pal[5]), 4)

for(i in seq(1:50)){
    data = data.frame( matrix(0, ngroup , 3))
    data[ , 1] = i
    data[ , 2] = sample(names, nrow(data))
    data[ , 3] = prop.table(sample( c(rep(0, 100), c(1:ngroup)), nrow(data)))
    DAT = rbind(DAT, data)
    }

colnames(DAT) <- c("x", "group", "value")
DAT <- DAT[order(DAT$x, DAT$group), ]

dim(DAT)

ggplot(DAT, aes(x = x, y = value, fill = group)) + 
  geom_area(alpha = 1, color = "transparent") +
  theme_bw() +
  scale_fill_brewer(palette = "Blues", breaks = rev(levels(DAT$group))) +
  theme(line = element_blank(),
        text = element_blank(),
        title = element_blank(),
        legend.position = "none",
        panel.border = element_blank(),
        panel.background = element_blank()
  )

## Save plot:
# cur_name <- paste0(pic_path, "art_grass", ".png")
# ggsave(cur_name, width = 15, height = 10, units = c("cm"), dpi = 300)

Harmonographs

Original version:

# Source: https://fronkonstin.com/2014/10/13/beautiful-curves-the-harmonograph/ 

f1 = jitter(sample(c(2,3),1)); f2 = jitter(sample(c(2,3),1)); f3 = jitter(sample(c(2,3),1)); f4 = jitter(sample(c(2,3),1))

d1 = runif(1,0,1e-02); d2=runif(1,0,1e-02); d3=runif(1,0,1e-02); d4=runif(1,0,1e-02)
p1 = runif(1,0,pi); p2=runif(1,0,pi); p3=runif(1,0,pi); p4=runif(1,0,pi)
xt = function(t) exp(-d1*t)*sin(t*f1+p1)+exp(-d2*t)*sin(t*f2+p2)
yt = function(t) exp(-d3*t)*sin(t*f3+p3)+exp(-d4*t)*sin(t*f4+p4)
t=seq(1, 100, by=.001)
dat = data.frame(t=t, x=xt(t), y=yt(t))
with(dat, plot(x, y, type="l", xlim =c(-2,2), ylim =c(-2,2), xlab = "", ylab = "", xaxt='n', yaxt='n'))

Adapted version:

# Adapted from: https://fronkonstin.com/2014/10/13/beautiful-curves-the-harmonograph/ 

seed <- 203
set.seed(seed)

f1 = jitter(sample(c(2, 3), 1))  
f2 = jitter(sample(c(2, 3), 1))  
f3 = jitter(sample(c(2, 3), 1))  
f4 = jitter(sample(c(2, 3), 1))

d1 = runif(1, 0, 1e-02)  
d2 = runif(1, 0, 1e-02)  
d3 = runif(1, 0, 1e-02)  
d4 = runif(1, 0, 1e-02)

p1 = runif(1, 0, pi)  
p2 = runif(1, 0, pi)  
p3 = runif(1, 0, pi)  
p4 = runif(1, 0, pi)

xt = function(t) exp(-d1 * t) * sin(t * f1 + p1) + exp(-d2*t) * sin(t * f2 + p2)
yt = function(t) exp(-d3 * t) * sin(t * f3 + p3) + exp(-d4*t) * sin(t * f4 + p4)

t = seq(1, 100, by = .001)

dat = data.frame(t = t, x = xt(t), y = yt(t))

with(dat, plot(x, y, type = "l", col = seeblau,  
               xlim = c(-2, 2), ylim = c(-2, 2), 
               xlab = "", ylab = "", 
               xaxt = 'n', yaxt = 'n')
     )

[This file last updated on 2019-02-11 08:39:41 by hn.]